home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dskut
/
reform12.zip
/
REFORM12.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-05-23
|
42KB
|
1,255 lines
PROGRAM reformat;
{
Program to reformat any disk attached to a Olivetti PC or compatible.
The progam will probably work well on any MS/PC-DOS machine running under
DOS 2.xx. Fixed disks of all sizes. [Toad Hall note: not correct.]
Global types }
TYPE
Regpack = RECORD CASE INTEGER OF
1: (ax, bx, cx, dx, bp, si, di, ds, es, flags : INTEGER);
2: (al, ah, bl, bh, cl, ch, dl, dh : Byte);
END;
Boot = RECORD
Jump: ARRAY[0..2] OF Byte;
OEM : ARRAY[0..7] OF CHAR;
sectorSize: INTEGER;
clusterSize: Byte;
reservedSectors: INTEGER;
numberOfFats: Byte;
rootDirSize,
totalSectors: INTEGER;
mediaDescriptor: Byte;
fatSize,
trackSize,
numberOfHeads,
numberOfHiddenSectors: INTEGER;
END;
IntArray = ARRAY[0..32766] OF INTEGER;
Buffer = ARRAY[0..32766] OF Byte;
longInteger = ARRAY[0..1] OF INTEGER;
DirectoryPointer = ^DirectoryEntry;
DirectoryEntry = RECORD
EntryName: ARRAY[0..10] OF CHAR;
attribute: Byte;
Reserved: ARRAY[1..10] OF Byte;
timeLastUpdated: INTEGER;
dateLastUpdated: INTEGER;
startingCluster: INTEGER;
fileSize: longInteger;
newStartingCluster: INTEGER;
Next,
SubDirectory: DirectoryPointer;
END;
WorkString = STRING[255];
CONST
READONLY = $01;
HIDDENFILE = $02;
SYSTEMFILE = $04;
VOLUMELABEL = $08;
SUBDIRECTORY = $10;
ARCHIVE = $20;
NEVERUSED = $00;
ERASED = $E5;
FIXEDDISK = $F8;
DUAL8SECTOR = $FF;
SINGLE8SECTOR = $FE;
DUAL9SECTOR = $FD;
SINGLE9SECTOR = $FC;
Unused: INTEGER = $0000;
ReservedMinimum: INTEGER = $0FF0;
ReservedMaximum: INTEGER = $0FF6;
BadCluster: INTEGER = $0FF7;
LastMinimum: INTEGER = $0FF8;
LastMaximum: INTEGER = $0FFF;
lastNormal: INTEGER = $0FFF;
VAR
{ Drive characteristics and constants communications block }
DriveLetter: CHAR;
numberOfFats,
media,
defaultDrive,
driveNumber: Byte;
freeClusters,
totalDataClusters,
firstDataSector,
fatSize,
firstFATsector,
rootDirSize,
directorySectors,
firstDirectorySector,
sectorSize,
clusterSize: INTEGER;
{ Global variables }
Registers: Regpack;
oldFATindex,
newFATindex,
errors,
lostClusters,
totalFiles,
hiddenFiles,
inRootDirectory,
inSubdirectories,
nonContiguousFiles,
subdirectories,
movedClusters,
clustersToMove,
count: INTEGER;
SAVEaddress,
DTAddress: ^Buffer;
PermutationAddress,
NewFATAddress,
OldFATAddress: ^IntArray;
RootDir: DirectoryPointer;
movedField,
inputField,
logField,
warningField,
errorField,
disasterField: longInteger;
Anything,
Instr: CHAR;
AlreadyWritten: BOOLEAN;
DiskLabel: ARRAY[0..10] OF CHAR;
{$I REFORMAT.INC Toad Hall Turbo Inline disk procedure Int2526}
PROCEDURE Beep;
BEGIN
WRITE(CHR(7));
END;
PROCEDURE WriteLog(S: WorkString);
VAR
count: INTEGER;
BEGIN
GotoXY(logField[0], logField[1]);
FOR count := logField[0] TO 79 DO WRITE(' ');
GotoXY(logField[0], logField[1]);
WRITE(S);
END; {of WriteLog}
PROCEDURE WriteWarning(S: WorkString);
VAR
count: INTEGER;
BEGIN
GotoXY(warningField[0], warningField[1]);
FOR count := warningField[0] TO 79 DO WRITE(' ');
GotoXY(warningField[0], warningField[1]);
WRITE(S);
END; {of WriteWarning}
PROCEDURE WriteError(S: WorkString);
VAR
count: INTEGER;
BEGIN
GotoXY(errorField[0], errorField[1]);
FOR count := errorField[0] TO 79 DO WRITE(' ');
GotoXY(errorField[0], errorField[1]);
WRITE(S);
END; {of WriteError}
PROCEDURE WriteDisaster(S: WorkString);
VAR
count: INTEGER;
BEGIN
GotoXY(disasterField[0], disasterField[1]);
FOR count := disasterField[0] TO 79 DO WRITE(' ');
GotoXY(disasterField[0], disasterField[1]);
WRITE(S);
END; {of WriteDisaster}
PROCEDURE GetInput(VAR Instr: CHAR);
VAR
count: INTEGER;
BEGIN
GotoXY(inputField[0], inputField[1]);
FOR count := inputField[0] TO 79 DO WRITE(' ');
GotoXY(inputField[0], inputField[1]);
Beep;
READLN(Instr);
Instr := Upcase(Instr);
END; {of GetInput}
PROCEDURE GetInformation;
{ Ask DOS for information about the specified or default disk.
If we have an error return code from DOS we assume that the disk
specified was invalid. }
VAR
ValidDrive: BOOLEAN;
InLetter: CHAR;
Instr: CHAR;
BEGIN
{ get current disk: MS-DOS function call 19h
information is returned in AL: 0 = A, 1 = B, etc.}
WriteLog('Reading Disk Information');
Registers.ah := $19;
MSDos(Registers);
defaultDrive := Registers.al;
IF paramcount = 0
THEN Instr := CHR(65 + defaultDrive)
ELSE Instr := COPY(paramstr(1), 1, 1);
ValidDrive := FALSE;
WITH Registers DO REPEAT
IF ORD(Instr) < 64 THEN Instr := CHR($FF);
DriveLetter := UpCase(Instr);
driveNumber := ORD(DriveLetter) - 64;
ah := $36;
dl := driveNumber;
MSDos(Registers);
IF ax <> $ffff
THEN BEGIN
driveNumber := PRED(driveNumber);
freeClusters := bx;
totalDataClusters := dx;
sectorSize := cx;
clusterSize := ax;
firstFATsector := 1;
count := ( totalDataClusters + 2 ) * 3 ;
IF count MOD ( sectorSize ShR 1 ) = 0
THEN fatSize := count DIV ( sectorSize ShL 1 )
ELSE fatSize := count DIV ( sectorSize ShL 1 ) + 1;
firstDirectorySector := SUCC(fatSize ShL 1);
ValidDrive := TRUE;
END
ELSE BEGIN
WriteWarning('Invalid driveletter, enter new letter!');
GetInput(Instr);
WriteWarning(' ');
END;
UNTIL ValidDrive;
END; {of GetInformation}
FUNCTION CarryFlag: BOOLEAN;
BEGIN
CarryFlag := ( Registers.Flags AND $01 ) <> 0 ;
END; {of CarryFlag}
PROCEDURE ResetDisk;
BEGIN
Registers.ah := $0D;
MSDos(Registers);
END; {of ResetDisk}
PROCEDURE ReadSectors(sectorNumber, numberOfSectors: INTEGER);
BEGIN
WITH Registers DO REPEAT
al := driveNumber;
cx := numberOfSectors;
dx := sectorNumber;
ds := Seg(DTAddress^);
bx := Ofs(DTAddress^);
Int2526($25); {Toad Hall disk read}
IF CarryFlag THEN BEGIN
IF NOT AlreadyWritten
THEN BEGIN
WriteWarning('No data lost!');
WriteError('Disk read error, enter A (abort), R (retry)?');
END
ELSE BEGIN
WriteError('Probably loss of data!');
WriteDisaster('Disk read error A(bort), R(etry), I(gnore)?');
END;
Instr := '?';
REPEAT
Getinput(Instr);
UNTIL ( Instr IN ['A', 'R'] )
OR (( Instr = 'I' ) AND AlreadyWritten );
IF Instr = 'A'
THEN BEGIN
ClrScr;
HALT;
END
ELSE BEGIN
WriteError(' ');
WriteWarning(' ');
WriteDisaster(' ');
IF Instr = 'I' THEN flags := 0;
END; END;
UNTIL NOT CarryFlag;
END; {of ReadSectors}
PROCEDURE Write